perm filename OCCULT.OLD[G,BGB]2 blob
sn#055613 filedate 1973-07-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00027 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE OCCULT - A HIDDEN LINE ELIMINATOR - FEBRUARY 1973.
C00009 00003 SUBR(OCCULT,WRLD) A HIDDEN LINE ELIMINATOR.
C00011 00004 SUBR(XYSORT,SPTR)----------------------------------------------
C00014 00005 COPY POTENT RIGHT HALVES TO LEFT.
C00016 00006 TEST FOR EMPTY WINDOWS.
C00019 00007 SUBR(CLIP)-----------------------------------------------------
C00022 00008 REPACK:
C00024 00009 SUBR(VSCAN)
C00027 00010 SUBR(ESCAN,S0)
C00029 00011 SUBR(MKTJ,FOLD0,EDGE0) MAKE A T-JOINT.
C00032 00012 SUBR(EHIDE)FACE,EDGE,VERTEX EDGE HIDE.
C00035 00013 SUBR(VHIDE,FACE,VERTEX) VERTEX HIDE.
C00037 00014 SUBR(COMPEE)EDG1,EDG2 COMPARE EDGE-EDGE.
C00040 00015 COMPARE E1 AND U1.
C00043 00016 SUBR(FUDGE,VERTEX,EDGE)
C00045 00017 SUBR(EBREAK,EDGE) EBREAK(EDGE) IS LIKE ESPLIT.
C00048 00018 SUBR(TJSCAN) SCAN TJ LIST & PROMULAGATE UNDER FACES.
C00051 00019 SUBR(PROMUL,UF,EDGE,VERTEX) PROMULGATE UNDER FACE ALONG THE FOLDS.
C00053 00020 SUBR(QEV,EDGE,VERTEX) DISTANCE VERTEX TO EDGE.
C00055 00021 SUBR(ZDEPTH,FACE,VERTEX) ZPP DEPTH.
C00058 00022 SUBR(KLJOTS,WORLD)
C00060 00023 SUBR(KLTMPS,WORLD) KILL ALL THE TMP VERTICES IN THE WORLD.
C00061 00024 SUBR(VERIFY)NAME,ARGCNT DIAGONOSTIC DISPLAY.
C00064 00025 FDPY:------------------------------------------------------------
C00066 00026 SUBR(WINDPY,S00) WINDOW DISPLAY.
C00068 00027 SUBR(STAT) DISPLAY OCCULT STATISTICS.
C00070 ENDMK
C⊗;
TITLE OCCULT - A HIDDEN LINE ELIMINATOR - FEBRUARY 1973.
;OCCULT IS DEPENDENT ON THE WING AND EULER PRIMITIVES.
EXTERN MKB,MKF,MKE,MKV
EXTERN KLB,KLF,KLE,KLV
EXTERN WING,LINKED
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN MKEV,MKFE,ESPLIT,KLEV,KLFE
EXTERN INVERT
;LINK NAMES RELEVANT ONLY TO OCCULT.
DEFINE UFACE(Q,E)<CAR Q,7(E)> ;UBER/UNDER FACE.
DEFINE UFACE.(Q,E)<DIP Q,7(E)>
DEFINE TJ(Q,V)<CAR Q,7(V)> ;TJOINT LIST.
DEFINE TJ.(Q,V)<DIP Q,7(V)>
TJLIST:0
DEFINE VALEN(Q,V)<CAR Q,7(V)> ;VERTEX VALENCE.
DEFINE VALEN.(Q,V)<DIP Q,7(V)>
DEFINE TJOINT(Q,V)<CAR Q,2(V)> ;TJOINT POINTER.
DEFINE TJOIN.(Q,V)<DIP Q,2(V)>
;DIAGNOSTICS.
DECLARE{TIME1,TIME2}
WORLD:0
EXTERN EDPY,VDPY
EXTERN DPYSET,DPYBUF,DPYOUT,DPYBRT,DPYBIG,BUFDPY
EXTERN AIVECT,AVECT,FLODPY,DECDPY,DPYSTR,DTYO
DMODE:-1 ;DIAGNOSTIC MODE.
ELIMIT: =12
PDLTOP:0 ;MAXIMUM DEPTH OF DEEP PDL.
DEEPDL:BLOCK =1024
WNDCNT:0 ;NUMBER OF XY-SORT WINDOWS.
COMCNT:0 ;NUMBER OF EDGE-EDGE COMPARES.
;OUTER MOST WINDOW FROM VSCAN.
DECLARE{XPPMIN,XPPMAX,YPPMIN,YPPMAX,ZPPMIN,ZPPMAX}
DECLARE{VXMIN,VXMAX,VYMIN,VYMAX,VZMIN,VZMAX}
SUBR(OCCULT,WRLD) ;A HIDDEN LINE ELIMINATOR.
;____________________________________________________________________
TDCA 1,1 ;CLEAR DIAGNOSTIC MODE ON ENTRY.
SETO 1, ;SET DIAGNOSTIC MODE ON ENTRY+1.
DAC 1,DMODE
;READ CLOCKS.
SETZ↔MSTIME↔DAC TIME1 ;REAL TIME.
SETZ↔RUNTIM↔DAC TIME2 ;RUN TIME.
;TRY TO HIDE VERTICES THAT WERE HIDDEN BEFORE.
DZM TJLIST ;TJOINT LIST ← NIL.
DZM COMCNT ;EDGE-EDGE COMPARES COUNT.
DZM WNDCNT ;WINDOW COUNT.
LAC WRLD↔DAC WORLD ;SAVE THE WORLD.
CALL(VSCAN) ;TRY TO HIDE VERTICES PREVIOUSLY HIDDEN.
;PLACE OUTERMOST WINDOW INTO THE DEEP PDL.
DZM PDLTOP ;MAXIMUM PDL DEPTH USED.
LACI 1,DEEPDL
DZM(1) ;WINDOW CUT DIRECTION (HORIZONTAL).
LAC 2,WRLD↔DAC 2,WORLD
PED 2,2 ;LAST POTENT EDGE.
PUSH 1,2
PUSH 1,[1] ;CURRENT EDGE COUNT.
PUSH 1,XPPMIN ;OUTER MOST WINDOW.
PUSH 1,XPPMAX
PUSH 1,YPPMIN
PUSH 1,YPPMAX
PUSH 1,2 ;ONLY EDGE IN WINDOW.
ZIP 1
;DO THIS WINDOW AND ALL ITS DESCENDANTS.
CALL(XYSORT,1)
CALL(TJSCAN)
CALL(STAT)
POP1J
ENDR OCCULT;2/25/73(BGB)_____________________________________________
SUBR(XYSORT,SPTR)----------------------------------------------
; DO WINDOW OR SPLIT IT IN TWO - BGB 25 FEB 1973.
ACCUMULATORS{S0,S1,S2,E,A}
;WINDOW DEEP STACK BLOCK FORMAT.
CUTFLG ←← -7 ;CUT DIRECTION SWITCH. 0 IN X. -1 IN Y.
ELAST ←← -6 ;LAST POTENT EDGE.
EDGCNT ←← -5 ;EDGE COUNT
XLO ←← -4 ;XL
XHI ←← -3 ;XH
YLO ←← -2 ;YL
YHI ←← -1 ;YH
;PUSH LATE BORN EDGES INTO THE CURRENT WINDOW.
LAC S0,SPTR ;WINDOW POINTER.
LAC 1,EDGCNT(S0) ;EDGE COUNT.
DIP 1,1 ;XWD ECNT,,ECNT
ADDI 1,-1(S0) ;XWD ECNT,,S0+ECNT-1 DEEP PDL PTR.
LAC E,ELAST(S0) ;LAST POTENT EDGE.
L1: LAC A,E↔POTEN E,E
JUMPE E,L2
TEST E,POTENT↔GO L1
PUSH 1,E
GO L1
L2: HLRZM 1,EDGCNT(S0) ;UPDATE EDGE COUNT.
DAC A,ELAST(S0) ;UPDATE LAST POTENT EDGE.
ANDI 1,377777↔SUBI 1,DEEPDL
CAMLE 1,PDLTOP↔DAC 1,PDLTOP ;MAXIMUM PDL DEPTH.
GO L2B
CALL(WINDPY,ARG1)
CALL({VERIFY+2},[ASCII/XSORT/],[0])
L2B:
;WINDOW ZERO POINTERS AND SIZE.
LAC S0,ARG1↔DAC S0,BEG0 ;BEGINNING.
LAC EDGCNT(S0)↔DAC SIZ0 ;SIZE.
LACN↔SLAC↔LAP S0↔DAC P0 ;PDL POINTER.
LAC BEG0↔ADD SIZ0↔SOS↔DAC END0 ;END.
;TEST FOR SMALL ENUF WINDOW POPULATION.
LAC SIZ0↔CAMGE ELIMIT ;THRESHOLD EDGE COUNT.
;EASY WINDOW - DO HIDDEN LINE ELIMINATON & EXIT.
GO[CALL(ESCAN,BEG0)↔POP1J]
;HARD WINDOW - FALL THRU & SPLIT THE WINDOW.
;COPY POTENT RIGHT HALVES TO LEFT.
LAC S0,P0
L3: LAC E,(S0)
TEST E,POTENT↔SETZ E,
DIP E,E↔DAC E,(S0)
AOBJN S0,L3
;CLIP EDGES INTO FIRST WINDOW.
XL←←13 ↔ XH←←14 ↔ YL←←15 ↔ YH←←16
L4: LAC S0,BEG0↔SLACI XLO(S0)↔LAPI XL↔BLT YH ;GET WINDOW 0.
LAC XH↔FSB XL↔CAMGE[1.0]↔POP1J
LAC YH↔FSB YL↔CAMGE[1.0]↔POP1J
LACM 1,CUTFLG(S0)↔ASH 1,1
LAC XL(1)↔FAD XH(1)
FSC -1↔DAC MID#
SKIPE CUTFLG(S0)
SKIPA YH,MID
LAC XH,MID ;MAKE WINDOW 1.
LAC[XWD XL,W1]↔BLT W1+3 ;SAVE WINDOW 1.
LAC 1,P0↔SETZ ;CLEAR INSIDER COUNT.
CAR 2,(1)↔CALL(CLIP)
ZIP(1)↔AOBJN 1,.-3
DAC SIZ1
;CLIP EDGES INTO SECOND WINDOW.
L5: LAC S0,BEG0
SLACI XLO(S0)
LAPI XL↔BLT YH ;GET WINDOW 0.
SKIPE CUTFLG(S0)
SKIPA YL,MID
LAC XL,MID ;MAKE WINDOW 2.
LAC 1,P0↔SETZ ;INSIDER EDGE COUNT.
CDR 2,(1)↔CALL(CLIP) ;LOOP EDGES,
ZAP(1)↔AOBJN 1,.-3 ;THRU CLIP.
;TEST FOR EMPTY WINDOWS.
L5A: DAC SIZ2↔ADD SIZ1
SKIPN↔POP1J ;BOTH WINDOWS EMPTY.
SKIPE SIZ1↔GO L5B ;WINDOW 1 EMPTY.
LAC S0,BEG0↔LAC MID↔SKIPE CUTFLG(S0)↔ADDI S0,2
DAC XLO(S0)↔LAC 1,P0↔HRLS(1)↔AOBJN 1,.-1
SETCMM CUTFLG(S0)↔GO L4
L5B:
SKIPE SIZ2↔GO L6 ;WINDOW 2 EMPTY.
LAC S0,BEG0↔LAC MID↔SKIPE CUTFLG(S0)↔ADDI S0,2
DAC XHI(S0)↔LAC 1,P0↔HLRS(1)↔AOBJN 1,.-1
SETCMM CUTFLG(S0)↔GO L4
;SETUP WINDOW POINTERS.
L6: LAC BEG0↔DAC BEG2
ADD SIZ2↔SOS↔DAC END2
ADDI 8↔DAC BEG1
ADD SIZ1↔SOS↔DAC END1
LACN SIZ2↔HRL BEG2↔MOVSM P2 ;AOBJN POINTER 2.
LACN SIZ1↔HRL BEG1↔MOVSM P1 ;AOBJN POINTER 1.
CALL(REPACK)
LAC S1,BEG1
LAC S2,BEG2
;SETUP WINDOW HEADER DATA.
L7: LAC ELAST(S2)↔DAC ELAST(S1) ;LAST POTENT EDGE.
SLACI XL↔LAPI XLO(S2)↔BLT YHI(S2) ;WINDOWS.
SLACI W1↔LAPI XLO(S1)↔BLT YHI(S1)
LAC SIZ1↔DAC EDGCNT(S1) ;WINDOW EDGE COUNTS.
LAC SIZ2↔DAC EDGCNT(S2)
SETCMB CUTFLG(S2)↔DAC CUTFLG(S1) ;CUT DIRECTION SWITCH.
;TWO CALLS ON XYSORT.
DAC S2,ARG1 ;CONVERT CURRENT EXECUTION TO SECOND.
CALL(XYSORT,S1) ;FIRST CALL.
JCALL XYSORT ;SECOND CALL.
;DATA GLOBAL TO CLIP AND REPACK.
DECLARE{BEG0,END0,SIZ0,P0}
DECLARE{BEG1,END1,SIZ1,P1}
DECLARE{BEG2,END2,SIZ2,P2}
W1:0↔0↔0↔0 ;WINDOW 1 SAVE AREA.
;2/25/73(BGB)_______________________________________________________
SUBR(CLIP)-----------------------------------------------------
; CLIP DETECTOR - SKIP WHEN EDGE CROSSES WINDOW.
;ARGUMENTS EXPECTED TO BE IN ACCUMULATORS XL,XH,YL,YH & 2.
ACCUMULATORS{C0,C1,C2,X0,X1,X2,Y0,Y1,Y2,XL,XH,YL,YH}
SKIPN 2↔POP0J
PVT C1,2↔LAC X1,XPP(C1)↔LAC Y1,YPP(C1)
NVT C2,2↔LAC X2,XPP(C2)↔LAC Y2,YPP(C2)
SETZB C1,C2
CAML Y1,YH↔IORI C1,8 ;NORTH.
CAMG Y1,YL↔IORI C1,4 ;SOUTH.
CAML X1,XH↔IORI C1,2 ;EAST.
CAMG X1,XL↔IORI C1,1 ;WEST.
JUMPE C1,HIT
CAML Y2,YH↔IORI C2,8 ;NORTH.
CAMG Y2,YL↔IORI C2,4 ;SOUTH.
CAML X2,XH↔IORI C2,2 ;EAST.
CAMG X2,XL↔IORI C2,1 ;WEST.
JUMPE C2,HIT
TDNE C1,C2 ;WHEN V1 & V2 ARE BEYOND THE WINDOW
POP0J ;IN THE SAME DIRECTION - EASY OUTSIDE.
L: LAC X0,X1↔FSB X0,X2↔MOVMS↔CAMGE X0,[1.0]↔GO[
LAC Y0,Y1↔FSB Y0,Y2↔MOVMS↔CAMGE Y0,[1.0]↔GO HIT↔GO .+1]
LAC X0,X1↔FAD X0,X2↔FSC X0,-1 ;MIDPOINT.
LAC Y0,Y1↔FAD Y0,Y2↔FSC Y0,-1
SETZ C0,
CAML Y0,YH↔IORI C0,8 ;NORTH.
CAMG Y0,YL↔IORI C0,4 ;SOUTH.
CAML X0,XH↔IORI C0,2 ;EAST.
CAMG X0,XL↔IORI C0,1 ;WEST.
JUMPE C0,HIT
TDNE C0,C1
GO .+5 ;FIRST HALF EASY OUT.
LAC C2,C0 ;FIRST HALF STILL IN DOUBT.
LAC X2,X0
LAC Y2,Y0↔GO L
TDNE C0,C2
POP0J ;BOTH HALVES EASY OUTSIDE.
LAC C1,C0 ;SECOND HALF STILL IN DOUBT.
LAC X1,X0
LAC Y1,Y0↔GO L
HIT: AOS↔AOS(P)↔POP0J
ENDR;2/25/73(BGB)-------------------------------------------------
REPACK:
BEGIN REPACK;________________________________________________________
ACCUMULATORS{LO,HI}
;PACK RIGHT HALFWORDS DOWNWARDS FORMING WINDOW 2.
LAC LO,BEG0↔LAC HI,END0
L1: CAML LO,HI↔GO L2
CDR(LO)↔SKIPE↔AOJA LO,L1 ;SCAN FOR HOLE.
CDR(HI)↔SKIPN↔SOJA HI,.-2 ;SCAN FOR EDGE.
DAP(LO)↔SOS HI↔AOJA LO,L1 ;PUT EDGE IN HOLE.
;PACK LEFT HALFWORDS DOWNWARDS FORMING WINDOW 1.
L2: LAC LO,BEG0↔LAC HI,END0
L3: CAML LO,HI↔GO L4
CAR(LO)↔SKIPE↔AOJA LO,L3 ;SCAN FOR HOLE.
CAR(HI)↔SKIPN↔SOJA HI,.-2 ;SCAN FOR EDGE.
DIP(LO)↔SOS HI↔AOJA LO,L3 ;PUT EDGE IN HOLE.
;CLEAR LEFT HALVES OF THE WINDOWS.
L4: LAC HI,END1↔LAC 1,SIZ1 ;COPY WINDOW 1 UP.
LAC LO,BEG0↔ADDI LO,-1(1)
L5: CAR(LO)↔DAPZ(HI)
SOS LO↔SOS HI↔SOJG 1,L5
LAC 1,P2↔ZIP(1)↔AOBJN 1,.-1
POP0J
BEND;2/25/73(BGB)
ENDR XYSORT;2/25/73(BGB)____________________________________________
SUBR(VSCAN)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,F,V,X,Y,Z}
;INITIALIZE EXTREMA FOR OUTERMOST WINDOW.
SLACI 400000↔DAC XPPMAX↔DAC YPPMAX↔DAC ZPPMAX
SETCM↔DAC XPPMIN↔DAC YPPMIN↔DAC ZPPMIN
DZM EOWPTR ;WINDOW DOESN'T EXIST YET.
LAC B,WORLD ;FOR ALL THE BODIES OF THE WORLD.
L1: CCW B,B↔CAMN B,WORLD↔POP0J
LAC V,B ;FOR ALL THE VERTICES OF EACH BODY.
L2: PVT V,V↔CAMN V,B↔GO L1
TEST V,POTENT↔GO L2
MARKZ V,TBIT1 ;CLEAR MAKE-PICTURE BIT.
;COLLECT EXTREMA.
LAC X,XPP(V)↔CAMGE X,XPPMIN↔GO[
DAC X,XPPMIN↔DAC V,VXMIN↔GO .+1]
LAC Z,ZPP(V)↔CAMGE Z,ZPPMIN↔GO[
DAC Z,ZPPMIN↔DAC V,VZMIN↔GO .+1]
LAC Y,YPP(V)↔CAMGE Y,YPPMIN↔GO[
DAC Y,YPPMIN↔DAC V,VYMIN↔GO .+1]
LAC X,XPP(V)↔CAMLE X,XPPMAX↔GO[
DAC X,XPPMAX↔DAC V,VXMAX↔GO .+1]
LAC Y,YPP(V)↔CAMLE Y,YPPMAX↔GO[
DAC Y,YPPMAX↔DAC V,VYMAX↔GO .+1]
LAC Z,ZPP(V)↔CAMLE Z,ZPPMAX↔GO[
DAC Z,ZPPMAX↔DAC V,VZMAX↔GO .+1]
;TRY TO HIDE THE VERTEX WUNDER THE FACE THAT HIDE IT LAST TIME.
CDR F,7(V)↔JUMPE F,L2 ;PREVIOUS OVER FACE.
TEST F,POTENT↔GO L2
DAC V,VERT#↔DAC F,FACE#↔PUSH P,B
CALL(WITHIN,FACE,VERT)↔GO L3
L2B: CALL(ZDEPTH,FACE,VERT)↔JUMPE L3
L2C: CALL(VHIDE,FACE,VERT)
L3: POP P,B↔LAC V,VERT↔LAC F,FACE↔GO L2
ENDR VSCAN;2/27/73(BGB)----------------------------------------------
SUBR(ESCAN,S0)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{E1,E2}
;DIAGONOSTIC DISPLAY WINDOW FRAME.
AOS WNDCNT ;INCREMENT WINDOW COUNT.
SKIPE DMODE↔GO[CALL(WINDPY,ARG1)
CALL({VERIFY+2},[ASCIZ/ESCAN/],[0])↔GO .+1]
;COMPARE EACH EDGE IN THE WINDOW WITH ALL THE OTHERS,
;WHEN TWO EDGES CROSS MAKE A TJOINT.
L0: LAC E1,S0↔DAC E1,EDG1 ;FIRST EDGE.
LAC -5(E1) ;EDGE COUNT.
CAIGE 2↔POP1J ;TAKES AT LEAST TWO.
ADD E1↔DAC EOWPTR ;END OF WINDOW + 1.
DZM@ ;PUT 0 AFTER THE WINDOW.
SOS EDG1
L1: AOS E1,EDG1↔DAC E1,EDG2
SKIPN E1,(E1)↔POP1J ;EXIT.
TEST E1,POTENT↔GO L1
L2: AOS E2,EDG2
SKIPN E2,(E2)↔GO L1
TEST E2,POTENT↔GO L2
;COMPARE EDGES.
CALL(COMPEE,@EDG1,@EDG2)
JUMPLE 1,L2
CAIN 1,441↔GO[CALL(MKTJ,@EDG1,@EDG2)↔GO L2]
GO L2
DECLARE{EDG1,EDG2}
ENDR;2/10/73------------------------------------------------------
;END OF WINDOW POINTER.
EOWPTR: 0
SUBR(MKTJ,FOLD0,EDGE0) ;MAKE A T-JOINT.
COMMENT . ⊗ MAKE T-JOINT MANDALA
This MKTJ called |
only by ESCAN, |
There is another FACE2 FOLD FACE1
"MKTJ" embedded |
in EHIDE, EDGE ⊗JOT EJUT
⊗-------------⊗-|------------⊗
V JUT|
|
⊗ .
LAC FOLD0↔DAC FOLD
LAC EDGE0↔DAC EDGE
SETQ(JOT,{EBREAK,FOLD})
SETQ(JUT,{EBREAK,EDGE})
;DISTINGUISH ZPP-OVER ≥ ZPP-UNDER.
LAC 1,JUT↔LAC 2,JOT
TJOIN. 1,2↔TJOIN. 2,1
LAC 0,ZPP(1)↔CAMG 0,ZPP(2)↔GO L1
EXCH 1,2↔DAC 1,JUT↔DAC 2,JOT
LAC EDGE↔EXCH FOLD↔DAC EDGE
L1: MARK 1,JUTBIT↔MARK 2,JOTBIT
;ORIENT EDGES WITH RESPECT TO FOLD FACES.
LAC 1,FOLD
PFACE 0,1↔DAC FACE1
NFACE 0,1↔DAC FACE2
SLACI(POTENT)↔AND@FACE1↔AND@FACE2↔ANDCAM@JUT
SETQ(V,{OTHER,EDGE,JUT})
LAC 1,JUT↔PED 1,1↔DAC 1,EJUT
CALL(QFEV,FACE1,FOLD,V)
JUMPG 1,[LAC EDGE↔EXCH EJUT↔DAC EDGE↔GO .+1]
;HIDE UNDER EDGES.
CALL(,FACE1,EJUT,JUT)
CALL(EHIDE,FACE2,EDGE,JUT)
CALL(EHIDE)
POP2J
DECLARE{FOLD,EDGE,EJUT,JOT,JUT,FACE1,FACE2,V}
ENDR MKTJ; BGB 14 FEB 73.-----------------------------------------
SUBR(EHIDE)FACE,EDGE,VERTEX ;EDGE HIDE.
COMMENT ⊗------------------------------------------------------------
⊗
LAC 1,ARG2↔DAC 1,EDGE↔TEST 1,POTENT↔POP3J
LAC 2,ARG3↔DAC 2,FACE↔TEST 2,POTENT↔POP3J
ALT. 1,2↔PED 0,2↔DAC EDG0↔DAC EDG1
LAC ARG1↔DAC V1↔SETQ(V2,{OTHER,EDGE,V1})
SKIPE DMODE↔GO[CALL(VERIFY,[ASCII/EHIDE/],[3])↔GO .+1]
;QMASK←(IF V2=NVT(E) THEN 200 ELSE 100).
LACI 200↔LAC 1,EDGE↔NVT 1,1
CAME 1,V2↔LACI 100↔DAC QMASK
;COMPARE EDGE WITH FACE.
L1: CALL(COMPEE,EDGE,EDG1)
JUMPLE 1,L2 ;DISJOINT.
TDNE 1,QMASK↔GO L3 ;V2 TOUCHING EDG1.
TRNN 1,1↔GO L2 ;CROSSING.
;CROSSING - CONTINUE INTO NEXT FACE OR MAKE A TJOINT.
L4: CALL(OTHER,EDG1,FACE)
TEST 1,POTENT↔GO L5
ALT 0,1↔CAMN 0,EDGE↔POP3J ;DON'T VISIT SAME FACE TWICE.
LAC 0,EDGE↔ALT. 0,1
DAC 1,FACE↔LAC EDG1↔DAC EDG0
;DISJOINT - CONTINUE ON THIS FACE OR HIDE EDGE.
L2: SETQ(EDG1,{ECCW,EDG1,FACE})
CAME 1,EDG0↔GO L1
LAC 1,EDGE↔MARKZ 1,POTENT ;HIDE THIS EDGE.
CALL(DPYALL)
CALL(VHIDE,FACE,V2)↔POP3J ;HIDE ALL ITS FRIENDS.
;TOUCHING.
L3: ;OUTSTR[ASCIZ/TOUCH /]
LAC 1,EDGE↔MARKZ 1,POTENT
CALL(DPYALL)↔POP3J
;MAKE A TJOINT.
L5: LAC 1,EDGE↔MARKZ 1,POTENT
PVT 1,1↔CAME 1,V2↔GO[CALL(INVERT,EDGE)↔GO .+1]
CALL(EBREAK,EDGE)↔MARK 1,JUTBIT↔PUSH P,1 ;JOINT UNDER T.
CALL(EBREAK,EDG1)↔MARK 1,JOTBIT↔POP P,2 ;JOINT OVER T.
TJOIN. 1,2↔TJOIN. 2,1
CALL(DPYALL)↔POP3J
DECLARE{FACE,EDG0,EDG1,EDGE,V1,V2,QMASK}
ENDR EHIDE;2/14/73(BGB)----------------------------------------------
SUBR(VHIDE,FACE,VERTEX) ;VERTEX HIDE.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F,V,E,E0}
LAC V,VERTEX
TEST V,POTENT↔POP2J ;EXIT IF VERTEX IS HIDDEN.
;SEE IF WE CAN HIDE THE JOT OF A JUT.
TEST V,JUTBIT↔GO L1
TJOINT V,V ;GET JOT.
CALL(ZDEPTH,FACE,V)↔JUMPE L1 ;NO - JOT IS OVER FACE.
DAC V,VERTEX ;YES - JOT IS UNDER FACE.
;HIDE THE VERTEX.
L1: LAC V,VERTEX↔MARKZ V,POTENT ;HIDE THE VERTEX.
CDR F,FACE↔DAP F,7(V) ;FACE HIDES THIS VERTEX.
;DIAGONOSTIC DISPLAY.
SKIPE DMODE↔GO[
CALL(VERIFY,[ASCII/VHIDE/],[2])↔GO .+1]
;HIDE ALL THE POTENT EDGES OF THIS VERTEX.
L2: CDR V,VERTEX↔PED E,V↔DAC E,E0
L3: TESTZ E,POTENT↔GO L4
SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L3↔GO L5
L4: CALL(EHIDE,FACE,E,V)
GO L2
;EXIT OR HIDE THE JUT OF A JOT.
L5: LAC V,VERTEX
TEST V,JOTBIT↔POP2J
TJOINT V,V↔DAC V,VERTEX ;GET JUT.
TEST V,POTENT↔POP2J↔GO L1 ;EXIT IF VERTEX IS HIDDEN.
ENDR VHIDE;2/14/73(BGB)----------------------------------------------
SUBR(COMPEE)EDG1,EDG2 ;COMPARE EDGE-EDGE.
COMMENT ⊗------------------------------------,¬----------------------
-1 EDGES ARE DISJOINT.
0 EDGES E1 AND E2 ARE IDENTICAL.
+441 EDGE CROSS EACH OTHER.
+110 PVT(E1) IS JOINED TO PVT(E2).
+120 PVT(E1) IS JOINED TO NVT(E2).
+210 NVT(E1) IS JOINED TO PVT(E2).
+220 NVT(E1) IS JOINED TO NVT(E2).
⊗
ACCUMULATORS{Q1,Q2,E1,E2,V1,V2,U1,U2}
DEFINE EPSLON<[0.01]>
AOS COMCNT
SETZ 1,↔LAC E1,ARG2↔LAC E2,ARG1
CAMN E1,E2↔POP2J; IDENTITY CASE.
;FETCH ENDPOINTS - RING'A'AROUND TJOINTS TO GET THE JOT.
PVT V1,E1↔NVT V2,E1
PVT U1,E2↔NVT U2,E2
TESTZ V1,JUTBIT↔TJOINT V1,V1
TESTZ V2,JUTBIT↔TJOINT V2,V2
TESTZ U1,JUTBIT↔TJOINT U1,U1
TESTZ U2,JUTBIT↔TJOINT U2,U2
;TEST FOR EDGES ALREADY HAVINGS A VERTEX OR TJOINT IN COMMON.
NIM 1,110↔CAMN V1,U1↔POP2J
NIM 1,120↔CAMN V1,U2↔POP2J
NIM 1,210↔CAMN V2,U1↔POP2J
NIM 1,220↔CAMN V2,U2↔POP2J
;THE SPAN OVERLAPPING TESTS PREVENT NASTY PARALLEL CASES.
;TEST FOR X-SPAN NOT OVERLAPPING.
LO1←←0 ↔ HI1←←1 ↔ LO2←←2 ↔ HI2←←3
LAC LO1,XPP(V1)↔LAC HI1,XPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,XPP(U1)↔LAC HI2,XPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO L0
;TEST FOR Y-SPAN NOT OVERLAPPING.
LAC LO1,YPP(V1)↔LAC HI1,YPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,YPP(U1)↔LAC HI2,YPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO[L0:
SETO 1,↔POP2J]
;COMPARE E1 AND U1.
L1: SETZ 1,↔LAC Q1,CC(E1)
LAC BB(E1)↔FMPR YPP(U1)↔FADR Q1,0
LAC AA(E1)↔FMPR XPP(U1)↔FADR Q1,0
LACM Q1↔CAMG EPSLON↔TRO 1,10
;COMPARE E1 AND U2.
LAC Q2,CC(E1)
LAC BB(E1)↔FMPR YPP(U2)↔FADR Q2,0
LAC AA(E1)↔FMPR XPP(U2)↔FADR Q2,0
LACM Q2↔CAMG EPSLON↔TRO 1,20
;EXIT WHEN U1 AND U2 ARE CLEAR OF E1 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,30↔GO .+2↔SETO 1,↔POP2J]
TRO 1,40 ;E1 CROSSES E2'S LINE.
;COMPARE E2 AND V1.
LAC Q1,CC(E2)
LAC BB(E2)↔FMPR YPP(V1)↔FADR Q1,0
LAC AA(E2)↔FMPR XPP(V1)↔FADR Q1,0
LACM Q1↔CAMG EPSLON↔TRO 1,100
;COMPARE E2 AND V2.
LAC Q2,CC(E2)
LAC BB(E2)↔FMPR YPP(V2)↔FADR Q2,0
LAC AA(E2)↔FMPR XPP(V2)↔FADR Q2,0
LACM Q2↔CAMG EPSLON↔TRO 1,200
;EXIT WHEN V1 AND V2 ARE CLEAR OF E2 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,300↔GO .+2↔SETO 1,↔POP2J]
TRO 1,400 ;E2 CROSSES E1'S LINE.
;ELIMINATE COINCIDANT EDGE-VERTEX OCCURENCES BY FUDGING.
TRNE 1,010↔GO[CALL(FUDGE,U1,E1)↔GO L1] ;U1 NEAR E1'S LINE.
TRNE 1,020↔GO[CALL(FUDGE,U2,E1)↔GO L1] ;U2 NEAR E1'S LINE.
TRNE 1,100↔GO[CALL(FUDGE,V1,E2)↔GO L1] ;V1 NEAR E2'S LINE.
TRNE 1,200↔GO[CALL(FUDGE,V2,E2)↔GO L1] ;V2 NEAR E2'S LINE.
;SOLVE FOR CROSSING LOCUS.
L2: DAC 1,AC1
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT#
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC XCROSS
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC YCROSS
LAC XCROSS↔FMPR[3.5]↔DAC XCRUX
LAC YCROSS↔FMPR[3.5]↔DAC YCRUX
LAC 1,AC1↔TRO 1,1↔POP2J
ENDR COMPEE;3/1/73(BGB)----------------------------------------------
DECLARE{XCROSS,YCROSS,ZCROSS,XCRUX,YCRUX}
SUBR(FUDGE,VERTEX,EDGE)
COMMENT ⊗------------------------------------------------------------
Move 2D vertex locus away from the edge alittle.
⊗↔ ACCUMULATORS{V,E}↔SAVAC(11)
SKIPE DMODE↔GO[CALL(VERIFY,[ASCII/FUDGE/],[2])↔GO .+1]
LAC V,VERTEX↔LAC E,EDGE↔DAC V,VERT
LAC BB(E)↔FSC -3↔FADRM YPP(V)
LAC AA(E)↔FSC -3↔FADRM XPP(V)
PED E,V↔DAC E,E0↔DAC E,E1
L: CALL(ECOEF↑,E1)
SETQ(E1,{ECCW,E1,VERT})
CAME 1,E0↔GO L
GETAC(11)↔POP2J
DECLARE{E0,E1,VERT}
ENDR FUDGE;3/1/73(BGB)--------------------------------------------
SUBR(ZDEDGE)EDGE; SOLVE FOR ZDEPTHS AT THE CROSSING(XCROSS,YCROSS).
COMMENT ⊗------------------------------------------------------------
;Z←((Z2-Z1)*(XCROSS-X1)/(X2-X1))+Z1
⊗
ACCUMULATORS{E,V1,V2}
LAC E,ARG1
PVT V1,E↔NVT V2,E
LACM 0,AA(E)↔LACM 1,BB(E)↔CAMGE 1,0↔GO L
;WHEN DX ≥ DY:
LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,XCROSS↔ FSBR 0,XPP(V1)↔FMPR 1,0
LAC 0,XPP(V2)↔FSBR 0,XPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
;WHEN DY > DX:
L: LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,YCROSS↔ FSBR 0,YPP(V1)↔FMPR 1,0
LAC 0,YPP(V2)↔FSBR 0,YPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
ENDR ZDEDGE;2/10/73--------------------------------------------------
SUBR(EBREAK,EDGE) ;EBREAK(EDGE) IS LIKE ESPLIT.
COMMENT . _________ __________ EBREAK MANDALA
nccw \ / pcw
\ /
+ ⊗ V
+|
| ENEW
-|
⊗ VNEW
+|
| E
-|
- ⊗
/ \
___ncw___/ \___pccw___.
ACCUMULATORS{B,E,V,Q,R,ENEW,VNEW,PV,NV}
;GET ZDEPTH AT CROSSING.
CALL(ZDEDGE,EDGE)
;CREATE A NEW EDGE AND A NEW VERTEX.
CDR E,EDGE↔PVT V,E↔CCW B,E
SETQ(VNEW,{MKV,B})↔MARK VNEW,TMPBIT+POTENT
EXCH 1,TJLIST↔TJ. 1,VNEW ;CONS VNEW TO TJ LIST.
LAC XCROSS↔DAC XPP(VNEW)↔LAC XCRUX↔XDC. 0,VNEW
LAC YCROSS↔DAC YPP(VNEW)↔LAC YCRUX↔YDC. 0,VNEW
LAC ZCROSS↔DAC ZPP(VNEW)
SETQ(ENEW,{MKE,B})↔MARK ENEW,POTENT
TESTZ E,FOLDED↔GO[MARK ENEW,FOLDED↔GO .+1]
TESTZ E,DARKEN↔GO[MARK ENEW,DARKEN↔GO .+1]
;COPY EDGE COEFFICIENTS.
SLACI AA(E)↔LAPI AA(ENEW)↔BLT CC(ENEW)
LAC 8(E)↔DAC 8(ENEW)
;PLACE EDGE AT END OF POTENT EDGE LIST.
LAC 1,WORLD↔NED 2,1↔NED. ENEW,1↔POTEN. ENEW,2
SKIPN EOWPTR↔GO .+4
DAC ENEW,@EOWPTR↔AOS EOWPTR↔DZM@EOWPTR
;PLACE VNEW BETWEEN E AND ENEW.
PED 0,V↔CAMN 0,E↔PED. ENEW,V
PED. ENEW,VNEW↔PVT PV,E↔PVT. PV,ENEW
PVT. VNEW,E↔NVT. VNEW,ENEW
PFACE 0,E↔PFACE. 0,ENEW
NFACE 0,E↔NFACE. 0,ENEW
;NEW UPPER WINGS ARE LIKE THE OLDE;
PCW 0,E↔CALL(WING,0,ENEW)
NCCW 0,E↔CALL(WING,0,ENEW)
;EDGES POINT AT EACH OTHER ACROSS VNEW.
NCCW. ENEW,E↔PCW. ENEW,E
NCW. E,ENEW↔PCCW. E,ENEW
LAC 1,VNEW↔POP1J
ENDR EBREAK;2/10/73(BGB)---------------------------------------------
SUBR(TJSCAN) ;SCAN TJ LIST & PROMULAGATE UNDER FACES.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{UF1,UF2,JUT,JOT,F1,F2,E,E1,E2,V1}
;SCAN THRU TJ-LIST FOR POTENT JUTS.
SKIPA JUT,TJLIST; ⊗V1
L1: TJ JUT,JUT; |
SKIPN JUT↔POP0J; F1 UF1 |E1
TEST JUT,JUTBIT↔GO L1; |
TEST JUT,POTENT↔GO L1; EDGE JUT ⊗JOT
PUSH P,JUT; SAVE. ⊗-------------⊗-|------------⊗
; |
; F2 UF2 |E2
; |
; ⊗
;PICKUP ALL THE FRIENDS OF THE PRESENT JUT.
TJOINT JOT,JUT↔PED E1,JOT ;JOT'S EDGES.
SETQ(E2,{ECCW,E1,JOT})
SETQ(V1,{OTHER,E1,JOT})
PED E,JUT↔TEST E,POTENT↔GO[ ;POTENT JUT EDGE.
SETQ(E,{ECCW,E,JUT})↔GO .+1]
PFACE F1,E↔TEST F1,POTENT↔DZM F1 ;POTENT JUT FACES.
NFACE F2,E↔TEST F2,POTENT↔DZM F2
;FORCE ORIENTATION AS IN THE MANDALA.
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V1)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V1)↔FADR 1,0
SKIPG 1↔EXCH E1,E2
;TRY TO HIDE THE JUT.
UFACE UF1,E1↔SKIPE UF1↔CAMN UF1,F1↔GO L2
CALL(ZDEPTH,UF1,JUT)↔JUMPE L2
CALL(VHIDE,UF1,JUT)↔GO L9
L2: UFACE UF2,E2↔SKIPE UF2↔CAMN UF2,F2↔GO L3
CALL(ZDEPTH,UF2,JUT)↔JUMPE L3
CALL(VHIDE,UF2,JUT)↔GO L9
;PROMULGATE UNDERFACES OF THIS JOT.
L3: CALL(,F2,E2,JOT)
CALL(PROMUL,F1,E1,JOT)
CALL(PROMUL)
L9: POP P,JUT↔GO L1
ENDR TJSCAN;3/4/73(BGB)-------------------------------------------
SUBR(PROMUL,UF,EDGE,VERTEX) ;PROMULGATE UNDER FACE ALONG THE FOLDS.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{A2,A3,E,V,F,JUT}
SKIPN F,UF↔POP3J
LAC E,EDGE↔TEST E,POTENT↔POP3J
LAC V,VERTEX↔TEST V,POTENT↔POP3J
SKIPE DMODE↔GO[CALL(VERIFY,[ASCII/PROML/],[3])
LAC F,UF↔LAC E,EDGE↔LAC V,VERTEX↔GO .+1]
;PLACE UF IN EDGE IF DIFFERENT FROM THE ONE IT MAY HAVE ALREADY.
UFACE 1,E↔CAMN 1,F↔POP3J ;CONSISTENT.
UFACE. F,E
L1: SETQ(V,{OTHER,E,V})
TESTZ V,JUTBIT↔POP3J
TESTZ V,JOTBIT↔GO L3
VALEN 0,V↔CAILE 0,3↔POP3J ;EXIT ON COMPLEX VERTICES.
;PROMULGATE UNDER FACE THRU A SIMPLE TWO FOLD VERTEX.
DAC E,1
L2: CALL(ECCW,1,V)
CAMN 1,E↔POP3J
TEST 1,FOLDED↔GO L2
GO L1
;SEE IF WE CAN WIPE THIS JOT'S JUT.
L3: TEST V,VBIT↔GO[FATAL({BUG TRAP PROMUL&L3})]
TJOINT JUT,V
TEST JUT,POTENT↔GO L2-1
PED 1,JUT
PFACE 0,1↔CAMN 0,F↔POP3J
NFACE 0,1↔CAMN 0,F↔POP3J
DAC F,UF↔DAC E,EDGE↔DAC V,VERTEX
CALL(ZDEPTH,F,JUT)↔JUMPE POP3J.
CALL(WITHIN,F,JUT)↔POP3J
CALL(VHIDE,F,JUT)
GO PROMUL
ENDR PROMUL;3/4/73(BGB)-------------------------------------------
SUBR(QEV,EDGE,VERTEX) ;DISTANCE VERTEX TO EDGE.
COMMENT ⊗____________________________________________________________
⊗↔ ACCUMULATORS{E,V}
LAC V,VERTEX
LAC E,EDGE
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
POP2J
ENDR QEV;2/10/73(BGB)________________________________________________
SUBR(QFEV,FACE,EDGE,VERTEX) ;DIRECTED DISTANCE VERTEX TO EDGE.
COMMENT ⊗____________________________________________________________
⊗↔ ACCUMULATORS{E,V}
LAC V,VERTEX
LAC E,EDGE
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,FACE↔MOVNS 1
POP3J
ENDR QFEV;2/10/73(BGB)_______________________________________________
SUBR(CROSSING)X,Y,E1,E2
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{TT,XPTR,YPTR,E1,E2}
LAC E2,ARG1
LAC E1,ARG2
LAC YPTR,ARG3
LAC XPTR,ARG4
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC(XPTR)
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC(YPTR)
POP4J
ENDR CROSSING;2/10/73(BGB)-------------------------------------------
SUBR(ZDEPTH,FACE,VERTEX) ;ZPP DEPTH.
COMMENT ⊗____________________________________________________________
Return AC0 =-1 when vertex is under the face.
Return AC0 = 0 when vertex is above the face.
Return AC1 = ZPP depth = (KK-AA*Xpp-BB*Ypp)/CC. ⊗
ACCUMULATORS{F,V}
LAC V,VERTEX
LAC F,FACE
LAC 1,KK(F)
LAC AA(F)↔FMPR XPP(V)↔FSBR 1,0
LAC BB(F)↔FMPR YPP(V)↔FSBR 1,0
FDVR 1,CC(F)
SETO↔CAMG 1,ZPP(V)↔SETZ ;ZPP-OVER > ZPP-UNDER.
POP2J
ENDR ZDEPTH;2/10/73(BGB)------------------------------------------
SUBR(ZDALT)FACE,XPP,YPP
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F}
LAC F,ARG3
LAC 1,KK(F)
LAC AA(F)↔FMPR ARG2↔FSBR 1,0
LAC BB(F)↔FMPR ARG1↔FSBR 1,0
FDVR 1,CC(F)
POP3J
ENDR ZDALT;2/10/73(BGB)----------------------------------------------
SUBR(WITHIN)FACE,VERTEX
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F,V,E,E0}
LAC F,ARG2
LAC V,ARG1
PED E,F↔DAC E,E0
L1: LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,F↔MOVNS 1
L2: JUMPLE 1,POP2J. ;VERTEX OUTSIDE FACE.
SETQ(E,{ECCW,E,F})
CAME E,E0↔GO L1
AOS(P)↔POP2J ;SKIP VERTEX WITHIN FACE.
ENDR WITHIN;2/27/73(BGB)---------------------------------------------
SUBR(KLJOTS,WORLD)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,V}
CDR B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JOTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
ENDR KLJOTS;2/16/73(BGB)---------------------------------------------
SUBR(KLJUTS,WORLD)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,V}
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V
TEST V,VBIT↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JUTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
ENDR KLJUTS;2/16/73(BGB)---------------------------------------------
SUBR(KLTMPS,WORLD) ; KILL ALL THE TMP VERTICES IN THE WORLD.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,V,E}
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
LAC E,B
L2: NED E,E↔CAMN E,B↔GO L3-1
TEST E,TMPBIT↔GO L2
NED E,E↔PUSH P,E↔PUSH P,B
PED E,E↔CALL(KLFE,E)
POP P,B↔POP P,E↔GO L2+1
LAC V,B
L3: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L3
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L3+1
ENDR KLTMPS;3/16/73(BGB)------------------------------------------
SUBR(VERIFY)NAME,ARGCNT ;DIAGONOSTIC DISPLAY.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN IDPY
CALL(DPYSET,DPYBUF)
AOS STEP
CALL(AIVECT,[-=510],[-=220])
CALL(DECDPY,STEP)↔CALL(DPYSTR,{[[ASCIZ/. /]]})
LAC ARG2↔DAC NAME↔CALL(DPYSTR,[NAME])
;GET POINTER TO HIS ARGUMENTS.
LACI 16,-3(17) ;STACK POINTER TO HIS RETURN ADR.
LAC ARG1↔SUB 16,0
MOVNS↔DIP 0,16 ;AOBJN POINTER.
DAC 16,SAV#
JUMPE 0,L3 ;HE'S GOT NO ARGUMENTS.
;DISPLAY ARGUMENT LIST.
PUSH P,["("]↔SKIPA
L0: CALL(DTYO,{[","]})↔CDR 1,(16)↔CALL(IDPY,1)↔AOBJN 16,L0
CALL(DTYO,{[")"]})
LAC 16,SAV
L1: CDR 1,(16)↔JUMPE 1,L2 ;GET AN ARGUMENT.
LAC 0,(1) ;GET ITS TYPE BITS.
TLNE(FBIT)↔GO[CALL(FDPY,1)↔GO L2]
TLNE(EBIT)↔GO[CALL(EDPY,1)↔GO L2]
TLNE(VBIT)↔GO[CALL(VDPY,1)↔GO L2]
L2: AOBJN 16,L1
L3: CALL(DPYOUT,[16])
SETZ↔SKIPE RUNFLG↔GO L4
;NOT RUNNING - SINGLE STEP VERIFICATION.
INCHRW
CAIN 175↔SETOM RUNFLG
CAIL"0"↔CAILE"9"↔POP2J
ANDI 17↔LAC 1,STEP2
IMULI 1,=10↔ADD 1↔DAC STEP2
GO L3
;RUNNING UNTIL STEP2 OR CHR.
L4: SKIPE 1,STEP2↔CAMLE 1,STEP↔GO .+4
DZM STEP2↔DZM RUNFLG↔GO L3
INCHRS↔POP2J↔DZM RUNFLG↔GO L3
RUNFLG:0
NAME:0↔0
STEP:0
STEP2:0
ENDR;2/24/73------------------------------------------------------
FDPY:;------------------------------------------------------------
BEGIN FDPY
LAC 1,ARG1↔DAC 1,F
PED 1,1↔DAC 1,E0↔DAC 1,E
CALL(DPYBRT,[3])
CALL(VCW,E,F)
XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AIVECT,0,1)
L: CALL(VCCW,E,F)
XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AVECT,0,1)
SETQ(E,{ECCW,E,F})
CAME 1,E0↔GO L↔CALL(DPYBRT,[2])↔POP1J
DECLARE{F,E,E0}
BEND;2/10/73------------------------------------------------------
DPYALL:;----------------------------------------------------------
BEGIN DPYALL
EXTERN AIVECT,AVECT
SKIPN DMODE↔POP0J
CALL(DPYSET,DPYBUF)
LAC 1,WORLD↔DAC 1,B
L1: LAC 1,B#↔CCW 1,1↔DAC 1,B
TEST 1,BBIT↔GO[CALL(DPYOUT,[1])↔POP0J]
DAC 1,E#↔DZM CNT#
L2: LAC 1,E↔PED 1,1↔DAC 1,E↔AOS CNT
TEST 1,EBIT↔GO L1
TEST 1,POTENT↔GO L2
PVT 2,1↔NVT 3,1
XDC 0,3↔FIXX↔PUSH P,
YDC 0,3↔FIXX↔PUSH P,
XDC 0,2↔FIXX↔PUSH P,
YDC 0,2↔FIXX↔PUSH P,
CALL(AIVECT)
CALL(AVECT)
GO L2
BEND;2/10/73------------------------------------------------------
SUBR(WINDPY,S00) ;WINDOW DISPLAY.
COMMENT ⊗------------------------------------------------------------
⊗↔ E←←S0←←12↔XL←←13↔XH←←14↔YL←←15↔YH←←16
CALL(DPYSET,DPYBUF)↔LAC 1,S00
SLACI -4(1)↔LAPI XL↔BLT YH
FMP XL,[3.5]↔FIXX XL,↔FMP YL,[3.5]↔FIXX YL,
FMP XH,[3.5]↔FIXX XH,↔FMP YH,[3.5]↔FIXX YH,
CALL(AIVECT,XL,YL)
CALL(AVECT,XH,YL)↔CALL(AVECT,XH,YH)
CALL(AVECT,XL,YH)↔CALL(AVECT,XL,YL)
CALL(DPYOUT,[14])↔CALL(DPYBRT,[5])
LAC S0,ARG1↔LACN -5(S0)↔DIP S0
SKIPE↔GO[LAC 1,(S0)↔PVT 2,1↔NVT 1,1
XDC XL,1↔YDC YL,1↔XDC XH,2↔YDC YH,2
FIXX XL,↔FIXX YL,↔FIXX XH,↔FIXX YH,
CALL(AIVECT,XL,YL)↔CALL(AVECT,XH,YH)
AOBJN S0,.↔GO .+1]
LAC 1,ARG1↔LAC E,-6(1)
L1: POTEN E,E↔JUMPE E,POP1J.
TEST E,POTENT↔GO L1
CALL(EDPY,E)↔GO L1
POP1J
ENDR WINDPY;---------------------------------------------------------
SUBR(STAT) ;DISPLAY OCCULT STATISTICS.
COMMENT ⊗------------------------------------------------------------
⊗↔ SKIPN DMODE↔POP0J
CALL(DPYSET,BUFDPY)
; SETZ↔TIMER↔SUB TIME1↔MOVM↔FLOAT↔FDVR[60.0]↔DAC TIME1
; SETZ↔RUNTIM↔SUB TIME2↔MOVM↔FLOAT↔FDVR[1000.0]↔DAC TIME2
; FDVR TIME1↔FMPR[100.0]↔FIXX↔DAC RATIO#
SETZ↔MSTIME↔SUB TIME1↔MOVM↔FLOAT↔SKIPN↔MOVSI (0.5)↔FDVRI (1000.0)↔DAC TIME1
SETZ↔RUNTIM↔SUB TIME2↔MOVM↔FLOAT↔SKIPN↔MOVSI (0.5)↔FDVRI (1000.0)↔DAC TIME2
FDVR TIME1↔FMPR[100.0]↔FIXX↔DAC RATIO#
CALL(DPYBIG,[1])
CALL(AIVECT,[=380],[=430])
CALL(DPYSTR,{[[ASCIZ/REAL TIME /]]})
CALL(FLODPY,TIME1,[2])
CALL(AIVECT,[=380],[=410])
CALL(DPYSTR,{[[ASCIZ/RUN TIME /]]})
CALL(FLODPY,TIME2,[2])
CALL(AIVECT,[=380],[=390])
CALL(DPYSTR,{[[ASCIZ/TIME SHARE /]]})
CALL(DECDPY,RATIO)
CALL(DTYO,["%"])
CALL(AIVECT,[=150],[-=400])
CALL(DPYSTR,{[[ASCIZ/PDLTOP /]]})↔CALL(DECDPY,PDLTOP)
CALL(DPYSTR,{[[ASCIZ/ WINDOWS /]]})↔CALL(DECDPY,WNDCNT)
CALL(DPYSTR,{[[ASCIZ/ COMPARES /]]})↔CALL(DECDPY,COMCNT)
CALL(DPYBIG,[2])
CALL(DPYOUT,[16])
SKIPN DMODE↔POP0J
CALL(DPYSET,DPYBUF)
CALL(DPYOUT,[15])
CALL(DPYOUT,[14])
POP0J
ENDR STAT;3/4/73(BGB)------------------------------------------------
END
OCCULT.FAI - EOF.